Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/record/recordnu.frm

Text File | 1995-05-02 | 6KB | 280 lines

VERSION 2.00
Begin Form RecordNumberfrm
   BackColor       =   &H00C0C0C0&
   Caption         =   "Record Numbers"
   ClientHeight    =   4080
   ClientLeft      =   1320
   ClientTop       =   1830
   ClientWidth     =   6285
   Height          =   4485
   Left            =   1260
   LinkTopic       =   "Form1"
   ScaleHeight     =   4080
   ScaleWidth      =   6285
   Top             =   1485
   Width           =   6405
   Begin CommandButton Command4
      Caption         =   "<"
      Height          =   330
      Left            =   1500
      TabIndex        =   5
      Top             =   1665
      Width           =   480
   End
   Begin CommandButton Command3
      Caption         =   "<<"
      Height          =   330
      Left            =   960
      TabIndex        =   4
      Top             =   1665
      Width           =   480
   End
   Begin CommandButton Command2
      Caption         =   ">>"
      Height          =   330
      Left            =   4590
      TabIndex        =   3
      Top             =   1680
      Width           =   480
   End
   Begin Data Data1
      Connect         =   ""
      DatabaseName    =   "C:\VB\BIBLIO.MDB"
      Exclusive       =   0   'False
      Height          =   270
      Left            =   1650
      Options         =   0
      ReadOnly        =   0   'False
      RecordSource    =   "Titles"
      Top             =   2970
      Width           =   2835
   End
   Begin TextBox Text1
      DataField       =   "Title"
      DataSource      =   "Data1"
      Height          =   345
      Left            =   1155
      TabIndex        =   1
      Top             =   435
      Width           =   3990
   End
   Begin CommandButton Command1
      Caption         =   ">"
      Height          =   330
      Left            =   4050
      TabIndex        =   0
      Top             =   1680
      Width           =   480
   End
   Begin Shape Shape1
      Height          =   1140
      Index           =   1
      Left            =   510
      Top             =   1185
      Width           =   5505
   End
   Begin Shape Shape1
      Height          =   1140
      Index           =   0
      Left            =   510
      Top             =   2490
      Width           =   5505
   End
   Begin Label Label3
      BackStyle       =   0  'Transparent
      Caption         =   "Field Name"
      ForeColor       =   &H00800000&
      Height          =   270
      Left            =   1170
      TabIndex        =   8
      Top             =   165
      Width           =   2520
   End
   Begin Label Label2
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Label with buttons"
      ForeColor       =   &H00800000&
      Height          =   225
      Index           =   1
      Left            =   1965
      TabIndex        =   7
      Top             =   1395
      Width           =   2040
   End
   Begin Label Label2
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Data Control"
      ForeColor       =   &H00800000&
      Height          =   225
      Index           =   0
      Left            =   1995
      TabIndex        =   6
      Top             =   2715
      Width           =   2040
   End
   Begin Label Label1
      BorderStyle     =   1  'Fixed Single
      Height          =   285
      Left            =   2070
      TabIndex        =   2
      Top             =   1695
      Width           =   1875
   End
End
Option Explicit
Dim TotRec As Long
Dim CurrRec As Long
Dim JustUsedFind As Integer        'flag for find function

Sub Command1_Click ()
On Error Resume Next
   Data1.Recordset.MoveNext

If Data1.Recordset.EOF Then
   Data1.Recordset.MoveLast
   MsgBox "This is the end of the database"
   Exit Sub
End If

End Sub

Sub Command2_Click ()
On Error Resume Next
   Data1.Recordset.MoveLast

End Sub

Sub Command3_Click ()
On Error Resume Next
   Data1.Recordset.MoveFirst

End Sub

Sub Command4_Click ()
On Error Resume Next
   Data1.Recordset.MovePrevious

If Data1.Recordset.BOF Then
   Data1.Recordset.MoveFirst
   MsgBox "This is the beginning of the database"
   Exit Sub
End If

End Sub

Sub Data1_Reposition ()
  Dim bm As String
  Dim ds As dynaset

  If JustUsedFind = True Then
    Set ds = Data1.Recordset.Clone()
    bm = Data1.Recordset.Bookmark
    ds.MoveFirst
    CurrRec = 1
    While ds.Bookmark <> bm
      CurrRec = CurrRec + 1
      ds.MoveNext
    Wend
    JustUsedFind = False
  End If
  SetRecNum

End Sub

Sub Data1_Validate (Action As Integer, Save As Integer)
  On Error GoTo ValErr

  'first check for a move from an addnew or edit record
  If Action < 5 Then
    SetRecNum
  End If

  Select Case Action
    Case 1          'First
      CurrRec = 1

    Case 2          'Previous
      If CurrRec = 1 Then Beep
      If CurrRec <> 1 Then CurrRec = CurrRec - 1

    Case 3          'Next
      If CurrRec = TotRec Then Beep
      If CurrRec <> TotRec Then CurrRec = CurrRec + 1

    Case 4          'Last
      CurrRec = TotRec

    Case 5          'AddNew
      'do nothing

    Case 6          'Update

    Case 7          'Delete
      TotRec = TotRec - 1
      SetRecNum

    Case 8
      'set the flag for use in the reposition event
      JustUsedFind = True

    Case 9          'BookMark
      'do nothing"

    Case 10          'Close

  End Select

  GoTo ValEnd

ValErr:
  Resume ValEnd

ValEnd:

End Sub

Sub Form_Load ()
Dim ds2 As dynaset
On Error GoTo LoadErr
  Data1.Refresh

  CurrRec = 1
  Set ds2 = Data1.Recordset.Clone()
  If ds2.BOF = False Then
    ds2.MoveLast
    TotRec = ds2.RecordCount
  Else
    TotRec = 0
  End If
  ds2.Close

  SetRecNum
  GoTo LoadEnd

LoadErr:
  Unload Me
  Resume LoadEnd

LoadEnd:


End Sub

Sub SetRecNum ()

If Data1.EditMode <> 2 Then

    If Data1.Recordset.BOF = True Then
      Data1.Caption = "Record BOF of " & TotRec
    ElseIf Data1.Recordset.EOF = True Then
      Data1.Caption = "Record EOF of " & TotRec
    Else
      Data1.Caption = "Record " & CurrRec & " of " & TotRec
      Label1.Caption = "Record " & CurrRec & " of " & TotRec
    End If
  End If
End Sub